Magnum One/Magnum One (Mid-American Digital) (Disc Manufacturing).iso/d18/opbonus.arc/MEGAPAGE.ARC/MEGAPAGE.PAS

Pascal/Delphi Source File | 1991-03-20 | 22.9 KB | 720 lines

{ --------------------------------------------------------------------------

                   MEGAPAGE v1.00 - Copyright 1990 Scott Samet

                        FidoNet 1:135/990   CI$ 70671,213

  --------------------------------------------------------------------------

  This program enhances the TurboPower Software Object Professional POPHELP
  screens.  It adds the OPRO manual page numbers to the help screens, so
  it's easier to look up the full information.

  To run this program, you need the OPRO.TXT file, the various OPxxxxx.TXT
  files, and the INDEX and INDEX2 files.  All these files are provided with
  OPRO.  For my version of OPRO, they are located in INDEX.LZH on the BONUS
  disk.  The program will read these files and create updated files ending
  with  "NEW".   None of the original files are altered.

  It takes about 200k of available memory to run MEGAPAGE.   A run time
  error 203 indicates more memory is needed.

  After running MEGAPAGE, execute "MAKEHELP OPRO.NEW" to compile the updated
  files and create an enhanced OPRO.HLP file.   Reload POPHELP so it uses the
  new file.

  -------------------------------------------------------------------------

                                      Notes

  By default, the program builds a list of identifers that appear in the
  INDEX and INDEX2 files that do NOT appear in the help files.  It creates
  an extra help file, OPXXXXXX.NEW, for these identifiers.  This information
  is sketchy at best, but it is better than nothing, and does point you to
  the correct place in the manual.

  You may disable this feature by using the /N switch on the command line.

  ------------------------------------------------------------------------

                              Technical Description

  The program reads the INDEX and INDEX2 files.  For each index reference,
  it creates a record on the heap, indexed by the identifier.  If the
  identifier is duplicated (like Init), the index entry is flagged to show
  that duplicates exist.  During this pass, an special index entry is made
  for each unit and object name encountered.

  The index files are read a second time.  For identifiers flagged as
  having duplicates, a second index entry is created.  This time, the
  identifier is qualified by the Object or Unit name, "RawWindow.Init".

  Next, it reads the text of the entire help system.  !TOPIC statements
  are located and the topic extracted.  If the topic does not match any
  of the short identifiers, it is ignored.  If it matches an unduplicated
  short identifier, the volume and page information is added to the help
  text.

  If the topic matches a duplicated short identifier, like Init, it scans
  the help text, searching for text that "looks like" the correct long
  identifer.  This is only a guess, but it's a fairly good one.  If the
  long identifer appears in the dictionary, the volume and page information
  is added to the help text.

  As dictionary entry is matched by a help topic, it's flagged to show
  that it's been used.

  After all the help text has been read, it makes one more pass over the
  index files (unless the /N switch is present).  Each item is checked
  against the dictionary to see if it was used.  Any item that was not used
  is added to the special OPXXXXXX.NEW file.

  The program has a hard-coded check so items from OPCOLOR are not written
  to the OPXXXXXX.  Since these items are (trivial) color names, like
  RedOnBlack, there's no need to waste space on them.

  -------------------------------------------------------------------------

  Credit goes to Thom Foulks, Colorado Springs, for the original ADDPAGES
  program that inspired MEGAPAGE.

  -------------------------------------------------------------------------}

{$M 16384,150000,655360}

Uses
  DOS, OPCrt, OPRoot, OPString;

Const
  VirginNo = '1.01';
  BuffSize = 16384;

Type
  RefPtr = ^RefRec;

  RefRec = Record
    Volume:   Char;
    Page:     Array [1..5] of Char;
    Topic:    Word;
    End;

  DeluxeStringDict = Object (StringDict)
    Constructor InitCustom(PoolSize : Word);
    end;

  { This constructor allocates the hash table to specified size, avoiding
    heap fragmentation and delays caused by expanding on the fly. }
  Constructor DeluxeStringDict.InitCustom(PoolSize : Word);
    {-Allocate hash pool}
  var
    S : Word;
  begin
    sdUsed := 0;
    sdPool := nil;
    sdStatus := 0;

    if not Root.Init then
      Fail;

    {Validate that PoolSize is a proper factor of two}
    if (PoolSize > 8192) or (PoolSize < 8) then begin
      Done;
      InitStatus := epFatal+ecBadParam;
      Fail;
    end;
    S := PoolSize;
    while S > 1 do begin
      if odd(S) then begin
        Done;
        InitStatus := epFatal+ecBadParam;
        Fail;
      end;
      S := S shr 1;
    end;

    if not GetMemCheck(sdPool, PoolSize*SizeOf(StringPtr)) then begin
      Done;
      InitStatus := epFatal+ecOutOfMemory;
      Fail;
    end;
    FillChar(sdPool^, PoolSize*SizeOf(StringPtr), 0);
    sdSize := PoolSize;
  end;

Var
  Dict:        DeluxeStringDict; {!!.01}
  Bias:        Word;
  ShortCnt:    Word;
  LongCnt:     Word;
  ObjCnt:      Word;
  OrigMem:     LongInt;

  Procedure AllocTextBuff (Var F: Text; Size: LongInt);
  Const
    MaxSize = 65531;
  Var
    P:   Pointer;
  Begin
    If Size > MaxSize
      Then Size := MaxSize;
    Size := Size and (Not 511);
    If Size <= 0
      Then Exit;
    Getmem (P, Size);
    If P = Nil
      Then Exit;
    SetTextBuf (F, P^, Size);
    End;

  Procedure FreeTextBuff (Var F: Text);
  Begin
    With TextRec (F) do
      If BufPtr <> @Buffer
        Then FreeMem (BufPtr, BufSize);
    End;

  Procedure Abort (S: String);
  Begin
    Writeln (S);
    Halt (255);
    End;

  Procedure CheckOpen (FN: PathStr);
  Begin
    If InOutRes <> 0
      Then Abort ('Unable to Open ' + FN + '; Error=' + Long2Str (IOResult));
    End;

  Procedure LogLineNo (S: String; Var N: Word; Force: Boolean);
  Begin
    If Force or (N = 1) or (N mod 100 = 0)
      Then Write (N:10, '   ', S);
    If Force
      Then Writeln
      Else Write (^M);
    Inc (N);
    end;

  Procedure LoadRefs (FN1, FN2: PathStr);
  Type
    String31 = String[31];
    String5  = String[5];
  Var
    CurrRef:   RefPtr;
    RefFile:   Text;
    Topic:     String31;
    ILine:     String;
    Pass:      Word;
    LineCnt:   Word;

    Function MakeRef (Vol: Char; Pg: String5): RefPtr;
    Var
      Ref:   RefPtr;
    Begin
      New (Ref);
      If Ref = Nil
        Then RunError (203);
      With Ref^ do Begin
        Volume := Vol;
        Move (Pg[1], Page, 5);
        Topic  := 0;
        End;
      MakeRef := Ref;
      End { MakeRef };

    Procedure TableRef (Vol: Char; Pg, Top, UnitName, ObjName: String31);
    Var
      Test:   RefPtr;
      I:      Word;
    Begin { TableRef }
      Top := Trim (Top);
      If Top = ''
        Then Exit;
      Pg  := LeftPad (Trim (Pg), 6);
      Delete (Pg, 3, 1);
      ObjName := Trim (ObjName);
      UnitName := Trim (UnitName);
      If (ObjName = '') or (ObjName[1] = '-')
        Then If (UnitName = '') or (UnitName[1] = '-')
          Then Begin
            ObjName := '';
            UnitName := '';
            End
          Else Begin
            ObjName := UnitName;
            UnitName := '';
            end;
      If Pass = 1
        Then Begin { First Pass }
          { Attempt to add to Short Dictionary }
          If Dict.Member (Top, LongInt (Test))
            Then If (Test <> Nil)
              Then Begin
                { First Duplicate, Release RefRec }
                Dispose (Test);
                Dict.Update (Top, LongInt (Nil));
                End
              Else { Additional duplicate - nothing }
            Else Begin
              { Unique reference - add to table }
              Inc (ShortCnt);
              Dict.Add (Top, LongInt (MakeRef (Vol, Pg)));
              I := Dict.GetStatus;
              If I = 10008
                Then RunError (203);
              If (0 < I) and (I < 20000)
                Then Abort ('Unable to add ' + Top);
              end;
          { Add Object Name to Short Dictionary }
          If Not Dict.Member (ObjName, LongInt (Test))
            Then begin
              Dict.Add (ObjName, LongInt (MakeRef (' ', '')));
              I := Dict.GetStatus;
              If I = 10008
                Then RunError (203);
              If (0 < I) and (I < 20000)
                Then Abort ('Unable to add ' + ObjName);
              If I = 0
                Then Inc (ObjCnt);
              end;
          end { First Pass }
        Else Begin { Second Pass }
          If (ObjName <> '') and (ObjName [1] <> '-')
            Then If (Dict.Member (Top, LongInt (Test))) and (Test = Nil)
              Then begin
                { Duplicate entries in short dictionary - create long entry }
                Inc (LongCnt);
                Dict.Add (ObjName + '.' + Top, LongInt (MakeRef (Vol, Pg)));
                I := Dict.GetStatus;
                If I = 10008
                  Then RunError (203);
                If (0 < I) and (I < 20000)
                  Then Abort ('Unable to add ' + ObjName + '.' + Top);
                end;
          end { Second Pass };
      End { TableRef };

  Begin { LoadRefs }
    ShortCnt := 0;
    LongCnt  := 0;
    ObjCnt   := 0;

    Pass := 1;
    Writeln;
    Writeln ('Loading Identifiers:');
    Assign (RefFile, FN1);
    AllocTextBuff (RefFile, 2* BuffSize);
    {$I-} Reset (RefFile); {$I+}
    If IOResult <> 0
      Then Abort ('Unable to open ' + FN1);
    LineCnt := 1;
    While Not Eof (RefFile) DO Begin
      Readln (RefFile, ILine);
      LogLineNo (FN1, LineCnt, False);
      If ILine[1] = '{'
        Then TableRef (ILine [2], Copy (ILine, 9, 6), Copy (ILine, 19, 28),
                       Copy (ILine, 47, 8), Copy (ILine, 57, 255));
      End;
    Close (RefFile);
    FreeTextBuff (RefFile);
    LogLineNo (FN1, LineCnt, True);

    Assign (RefFile, FN2);
    AllocTextBuff (RefFile, 2* BuffSize);
    {$I-} Reset (RefFile); {$I+}
    If IOResult <> 0
      Then Abort ('Unable to open ' + FN2);
    LineCnt := 1;
    While Not Eof (RefFile) DO Begin
      Readln (RefFile, ILine);
      LogLineNo (FN2, LineCnt, False);
      If ILine[1] = '{'
        Then TableRef (ILine [2], Copy (ILine, 6, 6), Copy (ILine, 24, 28),
                       Copy (ILine, 52, 8), Copy (ILine, 62, 255));
      End;
    Close (RefFile);
    FreeTextBuff (RefFile);
    LogLineNo (FN2, LineCnt, True);

    Pass := 2;
    Writeln;
    Writeln ('Loading non-unique identifiers:');
    Assign (RefFile, FN1);
    AllocTextBuff (RefFile, 2* BuffSize);
    {$I-} Reset (RefFile); {$I+}
    If IOResult <> 0
      Then Abort ('Unable to open ' + FN1);
    LineCnt := 1;
    While Not Eof (RefFile) DO Begin
      Readln (RefFile, ILine);
      LogLineNo (FN1, LineCnt, False);
      If ILine[1] = '{'
        Then TableRef (ILine [2], Copy (ILine, 9, 6), Copy (ILine, 19, 28),
                       Copy (ILine, 47, 8), Copy (ILine, 57, 255));
      End;
    Close (RefFile);
    FreeTextBuff (RefFile);
    LogLineNo (FN1, LineCnt, True);

    Assign (RefFile, FN2);
    AllocTextBuff (RefFile, 2* BuffSize);
    {$I-} Reset (RefFile); {$I+}
    If IOResult <> 0
      Then Abort ('Unable to open ' + FN2);
    LineCnt := 1;
    While Not Eof (RefFile) DO Begin
      Readln (RefFile, ILine);
      LogLineNo (FN2, LineCnt, False);
      If ILine[1] = '{'
        Then TableRef (ILine [2], Copy (ILine, 6, 6), Copy (ILine, 24, 28),
                       Copy (ILine, 52, 8), Copy (ILine, 62, 255));
      End;
    Close (RefFile);
    FreeTextBuff (RefFile);
    LogLineNo (FN2, LineCnt, True);

    End { LoadRefs };

  Function FormatReference (Ref: RefRec): String;
  Var
    P:   String[6];
  Begin
    FormatReference := '';
    With Ref do
      If (Volume = '*')
        Then FormatReference := ^M^J'Reference: Supplement'
      Else If (Volume <> ' ')
        Then Begin
          P := Copy (Page, 3, 3);
          While (Length (P) > 0) and (P[1] = '0') do Delete (P, 1, 1);
          P := Copy (Page, 1, 2) + '-' + P;
          If P[1] = ' '
            Then Delete (P, 1, 1);
          FormatReference := ^M^J'Reference: Vol ' + Volume + ', Pg ' + P;
          end;
    End;

Procedure ScanHelp (HelpFN, Ref1FN, Ref2FN: PathStr);
var
  MaxTopic:    Word;
  MaxName:     String[12];
  SaveTopic:   Word;

  Procedure ScanFile (FNIn: PathStr; NestLvl: Word);
  Var
    IFile:      Text;
    OFile:      Text;
    ILine:      String;
    RefLine:    String;
    Temp:       String;
    ScanTop:    String;
    Match:      RefPtr;
    I:          Word;
    J:          Word;
    TopicNo:    Word;
    SaveTopic:  Word;
    FNOut:      PathStr;
    CmdLine:    ^String;
    LineNo:     Word;
    ShowFN:     String[64];

    Procedure DoFixups (FN1, FN2, FNOut: PathStr; Var MaxTopic: Word);
    Type
      String31 = String[31];
    Var
      Ref:     RefPtr;
      HFile:   Text;
      RefFile: Text;
      Top:     String [31];
      ILine:   String;
      LineNo:  Word;

      Procedure CheckRef (Top, UnitName, ObjName, Class: String31);
      Var
        CurrRef: RefPtr;
        TempRef: RefPtr;
      Begin
        Top := Trim (Top);
        If Top = ''
          Then Exit;

        ObjName := Trim (ObjName);
        UnitName := Trim (UnitName);
        Class := Trim (Class);

        If (ObjName = '') or (ObjName[1] = '-')
          Then If (UnitName = '') or (UnitName[1] = '-')
            Then Begin
              ObjName := '';
              UnitName := '';
              End
            Else Begin
              ObjName := UnitName;
              UnitName := '';
              If Class = 'Method'
                Then Class := 'Proc';
              end;

        { Here we are quite arbitrary and throw away some things }

        If (StUpCase (ObjName) = 'OPCOLOR')
          Then Exit;

        If Not Dict.Member (Top, LongInt (CurrRef))
          Then CurrRef := Nil { not in short dictionary }
          Else If CurrRef = Nil { in short dictionary, but duplicated }
            Then If Not Dict.Member (Top, LongInt (CurrRef))
              Then CurrRef := Nil; { not in long or short }

        If CurrRef <> Nil
          Then With CurrRef^ do
            If Topic = 0
              Then Begin
                Class := Trim (Class);
                Inc (MaxTopic);
                Writeln (HFile, '!TOPIC ', MaxTopic, ' ', Top);
                Writeln (HFile, '!NOINDEX');

                Write (HFile, ^B);

                If ObjName <> ''
                  Then If Dict.Member (ObjName, LongInt (TempRef)) and (TempRef <> NIL)
                    Then With TempRef^ do
                      Write (HFile, ^D, Topic, ^E, ObjName, ^E)
                    Else Write (HFile, ObjName);

                Case Class[1] of
                  'D':
                    If Class = 'Direct'
                      Then Writeln (HFile, ' ', Top, ^B, ' (MAKEHELP Directive)')
                      Else Writeln (HFile, ' ', Top, ^B, ' (Conditional Define)');
                  'C':
                    Writeln (HFile, '.', Top, ^B,' (Constant)');
                  'T':
                    If Class = 'TConst'
                      Then Writeln (HFile, '.', Top, ^B, ' (Typed Constant)')
                      Else Writeln (HFile, '.', Top, ^B, ' (Type)');
                  'V':
                    Writeln (HFile, '.', Top, ^B, ' (Variable)');
                  'F':
                    Writeln (HFile, '.', Top, ^B, ' (Field)');
                  'E':
                    Writeln (HFile, '.', Top, ^B, ' (Enumerated Type element)');
                  'M':
                    Writeln (HFile, '.', Top, ^B, ' (Method)');
                  'P':
                    Writeln (HFile, '.', Top, ^B, ' (Procedure/Function)');
                  End;

                If UnitName <> ''
                  Then Begin
                    Writeln (HFile);
                    Write (HFile, 'See also:  ');
                    If Dict.Member (UnitName, LongInt (TempRef)) and (TempRef <> NIL)
                      Then With TempRef^ do
                        Writeln (HFile, ^D, Topic, ^E, UnitName, ^E)
                      Else Writeln (HFile, UnitName);
                    End;

                Writeln (HFile, FormatReference (CurrRef^));
                End;

        End { CheckRef };

    Begin { DoFixUps }
      Writeln;
      Writeln ('Building HELP text for missing items:');
      Assign (HFile, FNOut);
      AllocTextBuff (HFile, MaxAvail - 8192);
      Rewrite (HFile);

      Assign (RefFile, FN1);
      AllocTextBuff (RefFile, MaxAvail);
      {$I-} Reset (RefFile); {$I+}
      CheckOpen (FN1);
      LineNo := 1;
      While Not Eof (RefFile) DO Begin
        Readln (RefFile, ILine);
        LogLineNo (FN1, LineNo, False);
        If ILine[1] = '{'
          Then CheckRef (Copy (ILine, 19, 28), Copy (ILine, 47, 8),
                         Copy (ILine, 57, 255), 'Method');
        End;
      Close (RefFile);
      FreeTextBuff (RefFile);
      LogLineNo (FN1, LineNo, True);

      Assign (RefFile, FN2);
      AllocTextBuff (RefFile, MaxAvail);
      {$I-} Reset (RefFile); {$I+}
      CheckOpen (FN2);
      LineNo := 1;
      While Not Eof (RefFile) DO Begin
        Readln (RefFile, ILine);
        LogLineNo (FN2, LineNo, False);
        If ILine[1] = '{'
          Then CheckRef (Copy (ILine, 24, 28), Copy (ILine, 52, 8),
                         Copy (ILine, 62, 255), Copy (ILine, 15, 8));
        End;
      Close (RefFile);
      FreeTextBuff (RefFile);

      Close (HFile);
      FreeTextBuff (HFile);
      LogLineNo (FN2, LineNo, True);
      End { DoFixups };

  Begin { ScanFile }
    FNIn  := FExpand (FNIn);
    FNOut := JustPathName (FNIn) + '\' + JustName (FNIn) + '.NEW';
    ShowFN := LeftPad (JustFileName (FNIn), 12) + ' -> ' + JustFileName (FNOut);

    Assign (IFile, FNIn);
    Assign (OFile, FNOut);
    If NestLvl > 0
      Then begin
        AllocTextBuff (IFile, BuffSize);
        AllocTextBuff (OFile, BuffSize);
        end;
    {$I-} Reset (IFile); {$I+}
    CheckOpen (FNIn);
    Rewrite (OFile);
    CheckOpen (FNOut);

    ScanTop := '';
    RefLine := '';
    SaveTopic := 0;
    LineNo    := 1;

    While Not Eof (IFile) DO Begin
      Readln (IFile, ILine);
      LogLineNo (ShowFN, LineNo, False);
      Temp := StUpCase (ILine);
      If (ILine <> '') and (Temp[1] = ';')
        Then Begin
          If RefLine <> ''
            Then Writeln (OFile, RefLine);
          RefLine := '';
          End;
      If Copy (Temp, 1, 6) = '!BIAS '
        Then Begin
          Val (Trim (Copy (Temp, 6, 255)), I, J);
          If J = 0
            Then Bias := I;
          End
      Else If Copy (Temp, 1, 9) = '!INCLUDE '
        Then Begin
          Temp := Trim (Copy (Temp, 10, 255));
          ILine := Copy (ILine, 1, 9) + JustPathName (Temp) + JustName (Temp) + '.NEW';
          ScanFile (Temp, NestLvl + 1);
          End
      Else If Copy (Temp, 1, 7) = '!TOPIC '
        Then Begin
          If RefLine <> ''
            Then Writeln (OFile, RefLine);
          RefLine := '';
          ScanTop := '';
          Temp := Trim (Copy (ILine, 8, 255));
          I := Pos (' ', Temp);
          If I > 0
            Then Begin
              Val (Copy (Temp, 1, I - 1), TopicNo, J);
              Inc (TopicNo, Bias);
              If (J = 0) and  (TopicNo > MaxTopic)
                Then SaveTopic := TopicNo;
              Temp := Trim (Copy (Temp, I, 255));
              If Dict.Member (Temp, LongInt (Match))
                Then If Match = Nil
                  Then ScanTop := '.' + StUpCase (Temp)
                  Else With Match^ do Begin
                    RefLine := FormatReference (Match^);
                    Topic := TopicNo;
                    ScanTop := '';
                    End;
              End;
          End
      Else If (ScanTop <> '')
        Then If (Pos (ScanTop, Temp) > 0)
          Then begin
            I := Pos (ScanTop, Temp);
            J := I - 1;
            If Temp [J] = ^E
              Then Begin
                Delete (Temp, J, 1);
                Dec (J);
                end;
            While (J > 0) and (Temp [J] in ['A'..'Z', 'a'..'z', '0'..'9', '.']) do dec (J);
            While (I <= Length (Temp)) and (Temp [I] in ['A'..'Z', 'a'..'z', '0'..'9', '.']) do Inc (I);
            Temp := Copy (Temp, J + 1, I - J - 1);
            If Dict.Member (Temp, LongInt (Match))
              Then With Match^ do Begin
                RefLine := FormatReference (Match^);
                Topic := TopicNo;
                ScanTop := '';
                end;
            end;
      Writeln (OFile, ILine);
      End;
    If RefLine <> ''
      Then Writeln (OFile, RefLine);
    Close (IFile);
    LogLineNo (ShowFN, LineNo, True);
    FreeTextBuff (IFile);
    If SaveTopic > MaxTopic
      Then begin
        MaxTopic := SaveTopic;
        MaxName  := JustName (FNIn);
        end;

    If NestLvl = 0
      Then Begin
        Writeln (OFile, '; Maximum Topic is really ', MaxTopic, ' in ', MaxName);
        CmdLine := Ptr (PrefixSeg, $80);
        If Pos ('/N', StUpCase (CmdLine^)) = 0
          Then begin
            SaveTopic := MaxTopic;
            DoFixups (Ref1FN, Ref2FN, 'OPXXXXXX.NEW', MaxTopic);
            Writeln (OFile, '!INCLUDE OPXXXXXX.NEW');
            Writeln (OFile, '; Maximum Generated Topic is ', MaxTopic);
            End;

        Writeln;
        Writeln ('Summary:');
        Writeln (ShortCnt:10,           '  Identifiers');
        Writeln (LongCnt:10,            '  Non-unique Identifers');
        Writeln (ObjCnt:10,             '  Objects and Methods');
        Writeln (OrigMem - MaxAvail:10, '  Bytes used for identifiers');
        Writeln (MaxAvail:10,           '  Bytes left');
        Writeln (SaveTopic:10,          '  Maximum Input  Topic Number (', MaxName, ')');
        If Pos ('/N', StUpCase (CmdLine^)) = 0
          Then Writeln (MaxTopic:10,    '  Maximum Output Topic Number (OPXXXXXX)');
        Writeln;
        Writeln ('Run MAKEHELP ', JustFileName (FNOut), ' to update OPRO.HLP');
        end;

    Close (OFile);
    FreeTextBuff (OFile);
    End { ScanFile };

Begin { ScanHelp }
  OrigMem  := MaxAvail;
  Dict.InitCustom (8192);
  LoadRefs (Ref1FN, Ref2FN);

  Bias     := 0;
  MaxTopic := 0;
  MaxName  := '';

  Writeln;
  Writeln ('Converting Help files:');
  ScanFile (HelpFN, 0);
  End { ScanHelp };

Begin
  Writeln ('MEGAPAGE - V', VirginNo, ' - Add index information to TurboPower POPHELP files');
  Writeln ('Copyright 1990, Scott Samet');
  ScanHelp ('OPRO.TXT', 'INDEX', 'INDEX2');
  End.